(defun siftmerge (x y)
       (prog (r)
	     (setq r *sift-header*)
	mergeloop
	     (cond ((null x) (rplacd r y) (return (cdr *sift-header*)))
		   ((null y) (rplacd r x) (return (cdr *sift-header*)))
		   (t ((lambda (cx cy)
			       (cond ((< cx cy) (go yflush))
				     ((> cx cy) (go xflush))
				     ((memq (caar y) '(RT RTREG))
				      (go ykeep))
				     (t (go xkeep))))
		       (costimate (car x))
		       (costimate (car y)))))
	xkeep
	     (rplacd r (setq r x))
	xflush
	     (setq x (cdr x))
	     (go mergeloop)
	ykeep
	     (rplacd r (setq r y))
	yflush
	     (setq y (cdr y))
	     (go mergeloop)))